Nalezeni souboru

Otázka od: Viktor Marek

3. 9. 2002 16:23

Potreboval bych na prohledat vsechny dostupne disky a najit soubor znameho
jmena.
Nejak se mi nedari donutit nize uvedeny zdrojak k rozumne cinnosti. Najde mi
soubor pouze v aktuelnim adresari

Poradi nekdo co s tim

Predem diky za radu

Viktor Marek
viktor@mbox.vol.cz

procedure Najdi(cesta, soubor: string);
var
  Found: Integer;
  F: TSearchRec;
begin
  try
    Found := FindFirst(Cesta + soubor, faAnyFile, F);
    while Found = 0 do
      begin
        if (F.Attr and faDirectory = faDirectory) and (not ((F.Name = '..')
or
          (F.Name = '.'))) then
          Najdi(Cesta + '\' + F.Name, Soubor);
          ShowMessage(expandfilename(Soubor));
          Found := FindNext(F);
        end;
  finally
    FindClose(F);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
najdi('c:\','XXX.txt');
end;


---
Odchozí zpráva neobsahuje viry.
Zkontrolováno antivirovým systémem AVG (http://www.grisoft.cz).
Verze: 6.0.384 / Virová báze: 216 - datum vydání: 21.8.2002

Odpovedá: Petr Vones

3. 9. 2002 13:42

From: "Viktor Marek" <viktor@mbox.vol.cz>
> Potreboval bych na prohledat vsechny dostupne disky a najit soubor znameho
> jmena.

Podivej se na funkci SearchTreeForFile (unit ImageHlp)

Petr Vones

Odpovedá: Viktor Marek

3. 9. 2002 22:33

> Podivej se na funkci SearchTreeForFile (unit ImageHlp)

Diky za nakopnuti ale chova se to dost podivne. Jednou to prohrabe disk a
najde, podruhe prohrabe disk a nenajde a potreti bez hrabnuti na disk hned
katogoricky tvrdi, ze soubor na disku neni.
(Win2000, Delphi 5}


uses ..,Imagehlp,...;
.
.
procedure TForm1.Button1Click(Sender: TObject);
var
  FoundPath: array[0..MAX_PATH] of Char;
begin
  if SearchTreeForFile('C:\', 'DELPHI32.EXE', FoundPath) then
     ShowMessage(FoundPath)
     else ShowMessage('Soubor na disku neni!');
end;

Diky za odpoved

Viktor Marek
viktor@mbox.vol.cz





---
Odchozí zpráva neobsahuje viry.
Zkontrolováno antivirovým systémem AVG (http://www.grisoft.cz).
Verze: 6.0.384 / Virová báze: 216 - datum vydání: 21.8.2002

Odpovedá: Petr Vones

4. 9. 2002 3:35

From: "Viktor Marek" <viktor@mbox.vol.cz>
> Diky za nakopnuti ale chova se to dost podivne. Jednou to prohrabe disk a
> najde, podruhe prohrabe disk a nenajde a potreti bez hrabnuti na disk hned
> katogoricky tvrdi, ze soubor na disku neni.

A jakou to vraci chybu (GetLastError, RaiseLastWin32Error) ?

Petr Vones

Odpovedá: Pavel Gazda

4. 9. 2002 8:47

Ahoj,

zkontroluj si: '\'


> Nejak se mi nedari donutit nize uvedeny zdrojak k rozumne cinnosti. Najde
mi
> soubor pouze v aktuelnim adresari
>
> ...
> Found := FindFirst(Cesta + soubor, faAnyFile, F);
> ....
> Najdi(Cesta + '\' + F.Name, Soubor);
> ....
> najdi('c:\','XXX.txt');

Odpovedá: Viktor Marek

4. 9. 2002 16:09


> > Diky za nakopnuti ale chova se to dost podivne. Jednou to prohrabe disk
a
> > najde, podruhe prohrabe disk a nenajde a potreti bez hrabnuti na disk
hned
> > katogoricky tvrdi, ze soubor na disku neni.
>
> A jakou to vraci chybu (GetLastError, RaiseLastWin32Error) ?

GetLastError vraci "3"
RaiseLastWin32Error vraci "Win32 Error, Code 1447, okno nema posuvniky"

Diky za odpoved

Viktor Marek
viktor@mbox.vol.cz



---
Odchozí zpráva neobsahuje viry.
Zkontrolováno antivirovým systémem AVG (http://www.grisoft.cz).
Verze: 6.0.384 / Virová báze: 216 - datum vydání: 21.8.2002

Odpovedá: Viktor Marek

4. 9. 2002 9:48

Subject: Re: Nalezeni souboru


> > Diky za nakopnuti ale chova se to dost podivne. Jednou to prohrabe disk
a
> > najde, podruhe prohrabe disk a nenajde a potreti bez hrabnuti na disk
hned
> > katogoricky tvrdi, ze soubor na disku neni.
>
> A jakou to vraci chybu (GetLastError, RaiseLastWin32Error) ?


Jeste jsem prisel na jednu "zahadu". Nize uvedeny programek take prestal
fungovat na mem PC WIN200 (log soubor se vytvori, ale je prazdny) a na jinem
PC beha bez problemu (WIN98) - ze by
nakopnuta Windows?

Viktor Marek
viktor@mbox.vol.cz

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var f: TextFile;


procedure OpenLog;
begin
  AssignFile(f, 'files.log');
  Rewrite(f);
end;

procedure CloseLog;
begin
  CloseFile(f);
end;

procedure AddLog(S: string);
begin
  Write(f, S + #13#10);
end;

procedure ProcessDir(Path: string);
var SearchRec: TSearchRec;
begin
  if FindFirst(Path + '*.*', faAnyFile, SearchRec) = 0 then
  begin
    repeat
      if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        if SearchRec.Attr in [16..31] then // pokud je adresar, tak
pokracujem
          ProcessDir(Path + SearchRec.Name + '\')
        else // jinak ulozime jmeno souboru do logu.
          AddLog(Path + SearchRec.Name);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenLog;
  ProcessDir('C:\2\'); // kde zacit.
  CloseLog;
end;

end.



---
Odchozí zpráva neobsahuje viry.
Zkontrolováno antivirovým systémem AVG (http://www.grisoft.cz).
Verze: 6.0.384 / Virová báze: 216 - datum vydání: 21.8.2002

Odpovedá: Jiri Lev

4. 9. 2002 9:57

Jenom takovy postreh, SearchRec.Attr vraci (W2k, NTFS zkomprimovanej
disk) k standartnim atributum jeste neco navic...
Ja to resil takto

attr := IntToHex(Rec.Attr,4);
Delete(attr,1,2);

A potom to vracelo docela obstojne  

J

-----Original Message-----
From: delphi-l-owner@clexpert.cz [mailto:delphi-l-owner@clexpert.cz] On
Behalf Of Viktor Marek
Sent: Wednesday, September 04, 2002 10:42 AM
To: Konference Delphi 2000
Subject: Re: Nalezeni souboru


Subject: Re: Nalezeni souboru


> > Diky za nakopnuti ale chova se to dost podivne. Jednou to prohrabe
> > disk
a
> > najde, podruhe prohrabe disk a nenajde a potreti bez hrabnuti na
> > disk
hned
> > katogoricky tvrdi, ze soubor na disku neni.
>
> A jakou to vraci chybu (GetLastError, RaiseLastWin32Error) ?


Jeste jsem prisel na jednu "zahadu". Nize uvedeny programek take prestal
fungovat na mem PC WIN200 (log soubor se vytvori, ale je prazdny) a na
jinem PC beha bez problemu (WIN98) - ze by nakopnuta Windows?

Viktor Marek
viktor@mbox.vol.cz

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var f: TextFile;


procedure OpenLog;
begin
  AssignFile(f, 'files.log');
  Rewrite(f);
end;

procedure CloseLog;
begin
  CloseFile(f);
end;

procedure AddLog(S: string);
begin
  Write(f, S + #13#10);
end;

procedure ProcessDir(Path: string);
var SearchRec: TSearchRec;
begin
  if FindFirst(Path + '*.*', faAnyFile, SearchRec) = 0 then
  begin
    repeat
      if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        if SearchRec.Attr in [16..31] then // pokud je adresar, tak
pokracujem
          ProcessDir(Path + SearchRec.Name + '\')
        else // jinak ulozime jmeno souboru do logu.
          AddLog(Path + SearchRec.Name);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenLog;
  ProcessDir('C:\2\'); // kde zacit.
  CloseLog;
end;

end.



---
Odchozí zpráva neobsahuje viry.
Zkontrolováno antivirovým systémem AVG (http://www.grisoft.cz).
Verze: 6.0.384 / Virová báze: 216 - datum vydání: 21.8.2002

Odpovedá: Daniel Rott

4. 9. 2002 14:26

----- Original Message -----
From: "Viktor Marek" <viktor@mbox.vol.cz>
> if SearchRec.Attr in [16..31] then // pokud je adresar, tak pokracujem

Staci nahodit attribut Archivace a prestane to fungovat ...
if (SearchRec.Attr and faDirectory)<>0 then

Daniel
-------------------------------------------------------
Scanning complete: NO intelligent life form in range.

Odpovedá: Viktor Marek

4. 9. 2002 18:07

> A jakou to vraci chybu (GetLastError, RaiseLastWin32Error) ?

Takze jsem opet o kousek postoupil, ale chytrej z toho nejsem

Nize uvedeny kod spolehlive najde cokoliv v hlavnim adresari c:\Winnt
(vcetne vnorenych adresaru)
GetLastError = 18
RaiseLastWin32Error = 18

Je-li vsak soubor mimo adresar Winnt kdekoliv na disku pak
GetLastError = 3
RaiseLastWin32Error = 3 "system nemuze najit uvedenou cestu"


Viktor Marek
viktor@mbox.vol.cz


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,Imagehlp;
.
.
procedure TForm1.Button2Click(Sender: TObject);
var
  FoundPath: array[0..MAX_PATH] of Char;
begin
    if SearchTreeForFile('C:\', 'win.ini', FoundPath) then
      begin
       Label1.caption:=FoundPath;
       Label2.caption:='GetLastError=' + IntToStr(GetLastError);
      RaiseLastWin32Error;
       end
        else
          begin
           Label1.caption:='Soubor nenalezen';
           Label2.caption:='GetLastError=' + IntToStr(GetLastError);
           RaiseLastWin32Error;
       end;
    end;
end.




---
Odchozí zpráva neobsahuje viry.
Zkontrolováno antivirovým systémem AVG (http://www.grisoft.cz).
Verze: 6.0.384 / Virová báze: 216 - datum vydání: 21.8.2002

Odpovedá: Viktor Marek

5. 9. 2002 0:36

> > A jakou to vraci chybu (GetLastError, RaiseLastWin32Error) ?
>
> Takze jsem opet o kousek postoupil, ale chytrej z toho nejsem
>
> Nize uvedeny kod spolehlive najde cokoliv v hlavnim adresari c:\Winnt
> (vcetne vnorenych adresaru)
> GetLastError = 18
> RaiseLastWin32Error = 18
>
> Je-li vsak soubor mimo adresar Winnt kdekoliv na disku pak
> GetLastError = 3
> RaiseLastWin32Error = 3 "system nemuze najit uvedenou cestu"

Dalsim spekem je skutecnost, ze programek spolehlive chodi pod WIN95, 98

Proboha vysvetlete mi to nekdo!!!!!!!!!

Diky za odpoved

Viktor Marek
viktor@mbox.vol.cz


---
Odchozí zpráva neobsahuje viry.
Zkontrolováno antivirovým systémem AVG (http://www.grisoft.cz).
Verze: 6.0.384 / Virová báze: 216 - datum vydání: 21.8.2002

Odpovedá: Petr Vones

5. 9. 2002 3:55

From: "Viktor Marek" <viktor@mbox.vol.cz>
> Dalsim spekem je skutecnost, ze programek spolehlive chodi pod WIN95, 98

A kde nechodi a jaka je na tom systemu verze imagehlp.dll ? Z vyse uvedeneho
vypada, ze asi bude lepsi si to napsat primo pomoci FindFirst/Next (coz ta
funkce stejne tak dela), kde si budes moci pridat i dalsi veci dle potreby.

Petr Vones

Odpovedá: Viktor Marek

5. 9. 2002 19:11

> > Dalsim spekem je skutecnost, ze programek spolehlive chodi pod WIN95, 98
>
> A kde nechodi a jaka je na tom systemu verze imagehlp.dll ? Z vyse
uvedeneho
> vypada, ze asi bude lepsi si to napsat primo pomoci FindFirst/Next (coz ta
> funkce stejne tak dela), kde si budes moci pridat i dalsi veci dle
potreby.

Jak jsem psal tak na WIN95,98 programek bez problemu beha, na mojem PC s
WIN2000 a vsemy opravnymi zaplatami najde soubor pouze v adresari Winnt a
vsech jeho podadresarich. Pokud je ale hledany soubor kdekoliv jinde vcetne
rootu
program si ani neškrtne. Na WIN XP jsem nemel moznost chovani programu
vyzkouset.

Verze Imagehlp.dll v adresari c:\Winnt\system32\ je "5.00.2195.2778"

Pokud nekdo ma hotovy zdrojak na vyhledavani souboru "FindFirst/Next " a byl
by ochoten jej zaslat budu vdecny.

Diky za odpoved

Viktor Marek
viktor@mbox.vol.cz


---
Odchozí zpráva neobsahuje viry.
Zkontrolováno antivirovým systémem AVG (http://www.grisoft.cz).
Verze: 6.0.385 / Virová báze: 217 - datum vydání: 4.9.2002